home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d18 / whereis.arc / WHEREIS.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1991-04-28  |  2.4 KB  |  110 lines
  1. program where;
  2. uses dos;
  3.  
  4. type str80=string[80];
  5.  
  6. var numofiles:integer;
  7.  
  8. procedure instructions;
  9. begin
  10.   writeln ('Whereis ');
  11.   writeln ('   Usage: Whereis [filename.ext]');
  12.   writeln ('      or  Whereis *.com');
  13.   writeln ('          searches whole disk for .COM files');
  14. end;
  15.  
  16. procedure split(name:str80; var dir,filespec:str80);
  17. var i:integer;
  18. begin
  19.   i:=length(name);
  20.   while (i>0) and not (name[i] in [':','\']) do i:=i-1;
  21.   dir:=copy (name,1,i);
  22.   if dir[i] <> '\' then dir:=dir+'\';
  23.   filespec:=copy(name,i+1,length(name))
  24. end;
  25.  
  26. function out (a:integer):string;
  27. var s:string[2];
  28. begin
  29.   if a < 10 then
  30.   begin
  31.     str(a:1,s);
  32.     out:='0'+s
  33.   end
  34.     else
  35.     begin
  36.       str(a:2,s);
  37.       out:=s;
  38.      end;
  39. end;
  40.  
  41. procedure searchdirectory(path,filespec:str80);
  42. var fileinfo:searchrec;
  43.     f:file;
  44.     time:longint;
  45.     dt:datetime;
  46.     am:string[2];
  47. begin
  48.   findfirst(path+filespec,$3f,fileinfo);
  49.   while doserror=0  do
  50.   begin
  51.     assign (f,path+fileinfo.name);
  52.     {$I-}
  53.     reset(f);
  54.     {$I+}
  55.     if ioresult = 0 then
  56.     begin
  57.       numofiles:=numofiles+1;
  58.       getftime(f,time);
  59.       unpacktime (time,DT);
  60.       close (f);
  61.       dt.year:=dt.year-1900;
  62.       write (fileinfo.size:7,'   ');
  63.       write (out(dt.month),'/',out(dt.day),'/',out(dt.year),'    ');
  64.       if dt.hour<13 then am:='a' else
  65.       begin
  66.         dt.hour:=dt.hour-12;
  67.         am:='p';
  68.       end;
  69.       if dt.hour=0 then dt.hour:=12;
  70.       write (out(dt.hour),':',out(dt.min),am,'    ');
  71.       write (path);
  72.       for time:=1 to length(fileinfo.name) do
  73.       if fileinfo.name[time] in ['A'..'Z'] then
  74.       write (chr(ord(fileinfo.name[time])+ord('a')-ord('A')))
  75.       else
  76.       write (fileinfo.name[time]);
  77.       writeln;
  78.     end;
  79.     findnext(fileinfo);
  80.   end;
  81.   findfirst (path+'*.*',directory,fileinfo);
  82.   while doserror = 0 do
  83.   begin
  84.     if ((fileinfo.attr and directory) >0) and
  85.         (fileinfo.name <> '.') and
  86.         (fileinfo.name <> '..') then
  87.     searchdirectory(path+fileinfo.name+'\',filespec);
  88.     findnext (fileinfo)
  89.   end
  90.  end;
  91.  {main program}
  92.  
  93.  var dir,filespec:str80;
  94.      temp:integer;
  95.  begin
  96.   numofiles:=0;
  97.   temp:=filemode;
  98.   filemode:=0;
  99.   if paramcount =0 then
  100.   instructions
  101.   else
  102.   begin
  103.     split(paramstr(1),dir,filespec);
  104.     searchdirectory(dir,filespec);
  105.     writeln (numofiles,' files found');
  106.  end;
  107.   filemode:=temp;
  108.   end.
  109.  
  110.